Syntax10.Scn.Fnt
StampElems
Alloc
22 Aug 95
InfoElems
Alloc
Syntax10.Scn.Fnt
StampElems
Alloc
22 Aug 95
"Title": Run time debugger
"Author": mah
"Abstract": command module
"Keywords": 
"Version": 
"From":  25.10.94 16:53:38
"Until": 
"Changes": 
ParcElems
Alloc
Syntax10i.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
		mod: Modules.Module;			(* current module *)
		pc: LONGINT;					(* current pc *)
	END;
Syntax10.Scn.Fnt
	END;
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
		pos: LONGINT;					(* new position in text of PC *)
		name: ARRAY 32 OF CHAR;		(* name of file of module *)
		done: BOOLEAN;				(* TRUE -> pc somewhere set *)
	END;
Syntax10.Scn.Fnt
		base: LONGINT;
		syms: RTDC.Sym;
		regs: Sys.ExceptionInfo;
		modName: ARRAY 32 OF CHAR;
	END;
Syntax10.Scn.Fnt
VAR win: ARRAY 3 OF CHAR; level: INTEGER;
BEGIN
	level := 1; Texts.Read (s, win[0]); Texts.Read (s, win[1]); win[2] := 0X;
	REPEAT
		IF win = "(*" THEN INC (level)
		ELSIF win = "*)" THEN DEC (level) END;
		win[0] := win[1]; Texts.Read (s, win[1])
	UNTIL level = 0
END SkipComment;
Syntax10.Scn.Fnt
VAR found : BOOLEAN;
BEGIN
	REPEAT
		Texts.Scan (s);
		found := TRUE;
		WHILE (s.class=Texts.Char) & (s.c=CHR (28)) DO found := FALSE; Texts.Scan (s) END;	(* skip text elements *)
		IF (s.class=Texts.Char) & (s.c='(') THEN 
			Texts.Scan (s);
			IF (s.class=Texts.Char) & (s.c='*') THEN found := FALSE; SkipComment (s) ELSE RETURN END
		END
	UNTIL found;
END Token;
Syntax10.Scn.Fnt
VAR s: Texts.Scanner; set: SET; a: ARRAY 32 OF CHAR;
BEGIN
	Texts.OpenScanner (s, t, pos);
	REPEAT Token (s) UNTIL (s.class#Texts.Char) OR (s.c#';');		
	IF s.class # Texts.Name THEN RETURN END;
	IF ((s.s = "END") OR (s.s = "ELSE") OR (s.s = "ELSIF")) THEN pos := Texts.Pos (s)-1 END
END NextToken;
Syntax10.Scn.Fnt
	VAR p: TextFrames.Parc; beg: LONGINT;
BEGIN
	IF f = NIL THEN
		IF fnt = NIL THEN dsr := 0 ELSE dsr := - fnt.minY END
	ELSE
		TextFrames.ParcBefore(f(TextFrames.Frame).text, pos, p, beg);
		dsr := SHORT(p.dsr DIV TextFrames.Unit)
END GetDsr;
Syntax10.Scn.Fnt
VAR end, delta: LONGINT;
BEGIN
	delta := 200;
	LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
		IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
		TextFrames.Show (f, pos - delta); DEC(delta, 20)
END Show;
Syntax10.Scn.Fnt
VAR dsr: INTEGER; new: PCElem;
BEGIN
	WITH e: PCElem DO
		WITH msg : TextFrames.DisplayMsg DO
			IF ~ msg.prepare THEN
				GetDsr (msg.frame, msg.pos, msg.fnt, dsr);
				Display.CopyPattern(Display.white, iconPC, msg.X0, msg.Y0 + dsr, Display.paint)
			END
		|    msg : Texts.CopyMsg DO
			NEW (new); Texts.CopyElem (e, new); msg.e := new
		ELSE
		END
END PCElemHandle;
Syntax10.Scn.Fnt
VAR dsr: INTEGER; new: BPElem;
BEGIN
	WITH e: BPElem DO
		WITH msg : TextFrames.DisplayMsg DO
			IF ~ msg.prepare THEN
				GetDsr (msg.frame, msg.pos, msg.fnt, dsr);
				Display.CopyPattern(Display.white, iconBP, msg.X0, msg.Y0 + dsr, Display.paint)
			END
		|    msg : Texts.CopyMsg DO
			NEW (new); Texts.CopyElem(e, new); msg.e := new
		ELSE
		END
END BPElemHandle;
Syntax10.Scn.Fnt
VAR new: PCElem;
BEGIN
	NEW (new); new.handle := PCElemHandle;
	new.W := 13 * TextFrames.Unit; new.H := 9 * TextFrames.Unit;
	new.mod := mod; new.pc := pc;
	RETURN new
END AllocPCElem;
Syntax10.Scn.Fnt
VAR text: Texts.Text; beg, end, time: LONGINT;
BEGIN 
	Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan (s);
	IF ((s.class = Texts.Char) & (s.c = "^")) OR (Oberon.Par.frame = Oberon.Par.vwr.dsc) THEN 
		Oberon.GetSelection(text, beg, end, time);
		IF time >= 0 THEN Texts.OpenScanner(s, text, beg); Texts.Scan(s) END;
		Oberon.Par.text := text;
		Oberon.Par.pos := Texts.Pos (s)
	ELSE Oberon.Par.pos := Texts.Pos (s) END
END GetArg;
Syntax10.Scn.Fnt
VAR v: Viewers.Viewer; s: Texts.Scanner; r: Texts.Reader; pos, startPos: LONGINT; newpc: PCElem; i: INTEGER;
BEGIN
	WITH f: TextFrames.Frame DO
		WITH msg: SetPCMsg DO
			startPos := msg.pos; pos := startPos; Texts.OpenReader (r, f.text, 0); Texts.ReadElem(r);
			WHILE ~ r.eot & ~ (r.elem IS PCElem) DO
				IF r.elem IS BPElem THEN INC (msg.pos) END;
				Texts.ReadElem (r)
			END;
			IF ~ r.eot THEN pos := Texts.ElemPos (r.elem); Texts.Delete (f.text, pos, pos+1) END;
			v := Viewers.This (f.X, f.Y);
			Texts.OpenScanner(s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s);
			IF (msg.name = s.s) & (startPos >= 0) THEN
				newpc := AllocPCElem (Modules.ThisMod (msg.name), RTDT.PC ());
				Texts.WriteElem (w, newpc);
				NextToken (f.text, msg.pos);
				Texts.Insert (f.text, msg.pos, w.buf);
				Show (f, msg.pos + 1);
				lastPos := pos; lastBeginPC := RTDT.procs.beginPC; msg.done := TRUE
			END
		| msg: RTDB.GetBPMsg DO
			Texts.OpenReader (r, f.text, 0); Texts.ReadElem (r);
			WHILE ~ r.eot DO
				IF r.elem IS BPElem THEN
					v := Viewers.This (f.X, f.Y);
					Texts.OpenScanner(s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s);
					i := 0; WHILE (s.s[i] # 0X) & (s.s[i] # '.') DO INC (i) END; s.s[i] := 0X;
					IF ~ RTDB.BreakAtPC (s.s, Texts.ElemPos (r.elem)) THEN
						Texts.WriteString (w, s.s); Texts.WriteString (w, ": Illegal breakpoint pos ");
						Texts.WriteInt (w, Texts.ElemPos (r.elem), 0); Texts.WriteLn (w);
						Texts.Append (Oberon.Log, w.buf)
					END
				END;
				Texts.ReadElem (r)
			END
		ELSE PrevFrameHandle (f, msg) END
END FrameHandle;
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
VAR msg: SetPCMsg; x, y, i: INTEGER; v: Viewers.Viewer; f, f2: TextFrames.Frame; t: Texts.Text; pc: LONGINT;
BEGIN
	pc := RTDT.PC (); RTDB.PCToPos (pc, msg.name, msg.pos);
	IF ~RTDT.Debugging () THEN msg.pos := -1 END;
	i := 0; WHILE msg.name[i] # 0X DO INC (i) END;
	msg.name[i] := '.'; msg.name[i+1] := 'M'; msg.name[i+2] := 'o'; msg.name[i+3] := 'd'; msg.name[i+4] := CHR(0);
	msg.done := FALSE;
	Viewers.Broadcast (msg);
	IF ~msg.done & RTDT.Debugging () THEN 						(* text not shown -> open a new one *)
		Oberon.AllocateUserViewer (0, x, y);
		t := TextFrames.Text (msg.name);
		FoldElems.ExpandAll (t, 0, TRUE);
		v := MenuViewers.New (TextFrames.NewMenu (msg.name, "^Edit.Menu.Text"),
			TextFrames.NewText (t, msg.pos-100), TextFrames.menuH, x, y);
		v.handle (v, msg);
END PCHandler;
Syntax10.Scn.Fnt
VAR msg: SetPCMsg;
BEGIN msg.pos := -1; Viewers.Broadcast (msg)
END PCOffHandler;
Syntax10.Scn.Fnt
VAR t: Text;
BEGIN
	NEW (t); Texts.Open (t, ""); t.notify := TextFrames.NotifyDisplay;
	t.base := base; t.syms := syms; t.regs := regs; COPY (modName, t.modName);
	RETURN t
END NewText;
Syntax10.Scn.Fnt
VAR msg: UpdateDataMsg;
BEGIN Viewers.Broadcast (msg)
END DataHandler;
Syntax10b.Scn.Fnt
Syntax10.Scn.Fnt
VAR dummy: ARRAY RTDT.StackSize OF LONGINT;
BEGIN IF RTDT.Debugging () THEN RTDB.StepAll; HALT (RTDT.EnterDebugMode) END
END StepInto;
Syntax10.Scn.Fnt
VAR dummy: ARRAY RTDT.StackSize OF LONGINT;
BEGIN IF RTDT.Debugging () THEN RTDB.StepOverAll; HALT (RTDT.EnterDebugMode) END
END Step;
Syntax10.Scn.Fnt
VAR dummy: ARRAY RTDT.StackSize OF LONGINT;
BEGIN IF RTDT.Debugging () THEN RTDT.PopProc; RTDB.StepOverAll; HALT (RTDT.EnterDebugMode) END
END Return;
Syntax10.Scn.Fnt
VAR dummy: ARRAY RTDT.StackSize OF LONGINT;
BEGIN IF RTDT.Debugging () THEN RTDB.BreakAll; HALT (RTDT.EnterDebugMode) END
END Run;
Syntax10.Scn.Fnt
BEGIN RTDT.Install
END PostMortem;
Syntax10.Scn.Fnt
VAR m: RTDB.ModuleInfo;
BEGIN
	m := RTDB.modules;
	WHILE m # NIL DO Texts.WriteString (w, m.name); Texts.WriteLn (w); m := m.next END;
	Texts.Append (Oberon.Log, w.buf)
END ShowModules;
Syntax10.Scn.Fnt
VAR v: Viewers.Viewer; x, y: INTEGER; p: RTDT.Proc; t: Texts.Text;
BEGIN
	p := RTDT.procs;
	WHILE p # NIL DO
		Texts.WriteString (w, p.modName); Texts.Write (w, '.'); Texts.WriteString (w, p.name);
		Texts.WriteLn (w);
		p := p.up
	END;
	t := TextFrames.Text (""); Texts.Append (t, w.buf);
	Oberon.AllocateSystemViewer (0, x, y);
	v := MenuViewers.New (
		TextFrames.NewMenu ("RTD.Stack", "System.Close RTD.Data RTD.Source "),
		TextFrames.NewText (t, 0),
		TextFrames.menuH,
		x, y)	
END Stack;
Syntax10.Scn.Fnt
	proc: RTDT.Proc;
	i, off, x, y: INTEGER;
	name, modName, procName: ARRAY 64 OF CHAR;
	s: Texts.Scanner;
	pos: LONGINT;
	t: Texts.Text;
	v: Viewers.Viewer;
BEGIN
	GetArg (s); 
	IF s.class # Texts.Name THEN RETURN END;
	COPY (s.s, name); i := 0;
	WHILE (name[i] # '.') & (name[i] # CHR (0)) DO modName[i] := name[i]; INC (i) END;
	modName[i] := CHR (0);
	IF name[i] = '.' THEN
		off:=0; INC (i);
		WHILE name[i+off] # CHR (0) DO procName[off] := name[i + off]; INC (off) END; procName[off] := CHR (0);
		proc := RTDT.procs;
		WHILE (proc # NIL) & ((proc.name # procName) OR (proc.modName # modName)) DO proc := proc.up END;
		IF proc # NIL THEN
			RTDB.PCToPos (proc.pc, name, pos);
			i := 0; WHILE modName[i] # 0X DO INC (i) END;
			modName[i] := '.'; modName[i+1] := 'M'; modName[i+2] := 'o'; modName[i+3] := 'd'; modName[i+4] := CHR(0);
			Oberon.AllocateUserViewer (0, x, y);
			t := TextFrames.Text (modName);
			FoldElems.ExpandAll (t, 0, TRUE);
			v := MenuViewers.New (TextFrames.NewMenu (modName, "^Edit.Menu.Text"),
				TextFrames.NewText (t, pos-100), TextFrames.menuH, x, y);
			TextFrames.SetCaret (v.dsc.next(TextFrames.Frame), pos)	
		END
END Source;
Syntax10.Scn.Fnt
VAR e: BPElem; m: TextFrames.InsertElemMsg; f: Display.Frame; h: Display.Handler; 
BEGIN
	NEW (e); m.e := e;
	e.W := 13 * TextFrames.Unit; e.H := 9 * TextFrames.Unit;
	e.handle := BPElemHandle;
	Oberon.FocusViewer.handle(Oberon.FocusViewer, m)
END Breakpoint;
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
	i, off, x, y: INTEGER;
	name, modName, procName: ARRAY 64 OF CHAR;
	s: Texts.Scanner;
	mod: Modules.Module;
	v: Viewers.Viewer;
	f: TextFrames.Frame;
	syms: RTDC.Sym;
	proc: RTDT.Proc;
	t: Text;
BEGIN
	GetArg (s); 
	IF s.class # Texts.Name THEN RETURN END;
	COPY (s.s, name); i := 0;
	WHILE (name[i] # '.') & (name[i] # CHR (0)) DO modName[i] := name[i]; INC (i) END;
	modName[i] := CHR (0);
	IF name[i]#'.' THEN 
		RTDC.Symbols (modName, syms);
		IF syms = NIL THEN
			Texts.WriteString (w, modName); Texts.WriteString (w, " not compilable");
			Texts.WriteLn (w); Texts.Append (Oberon.Log, w.buf);
			RETURN
		END;
		mod := Modules.ThisMod (modName);
		RTDD.GetScope (w, NIL, syms, mod.SB, 0);
		t := NewText (syms, mod.SB, NIL, modName)
	ELSE									(* procedure *)
		off:=0; INC (i);
		WHILE name[i+off] # CHR (0) DO procName[off] := name[i + off]; INC (off) END; procName[off] := CHR (0);
		proc := RTDT.procs;
		WHILE (proc # NIL) & ((proc.name # procName) OR (proc.modName # modName)) DO proc := proc.up END;
		IF proc = NIL THEN
			Texts.WriteString (w, name); Texts.WriteString (w, " not on stack"); 
			Texts.WriteLn (w); Texts.Append (Oberon.Log, w.buf);
			RETURN
		END;
		syms := RTDC.FindProc (proc);
		RTDD.GetLocalScope (w, NIL, syms, proc.regs, 0);
		t := NewText (syms, 0, proc.regs, modName)
	END;
	Oberon.AllocateUserViewer (0, x, y);
	f := TextFrames.NewText (t, 0);
	Texts.Append (f.text, w.buf);
	v := MenuViewers.New (TextFrames.NewMenu (name, "^Edit.Menu.Text"), f, TextFrames.menuH, x, y)
END Data;
Syntax10.Scn.Fnt
	VAR line: ARRAY 10 OF SET;
BEGIN
	line[1] := {3..9};
	line[2] := {1..11};
	line[3] := {0, 1, 3..7, 11, 12};
	line[4] := {0, 1, 3..6, 8..12};
	line[5] := {0, 1, 5, 6, 8..12};
	line[6] := {0, 1, 3, 4, 6, 8..12};
	line[7] := {0, 1, 5..7, 11, 12};
	line[8] := {1..11};
	line[9] := {3..9};
	iconPC := Display.NewPattern(line, 13, 9);
	line[1] := {3..9};
	line[2] := {1..11};
	line[3] := {0, 1, 5, 6, 8..12};
	line[4] := {0, 1, 3, 4, 6, 8..12};
	line[5] := {0, 1, 5, 6, 10..12};
	line[6] := {0, 1, 3, 4, 6, 8, 9, 11, 12};
	line[7] := {0, 1, 5, 6, 10..12};
	line[8] := {1..11};
	line[9] := {3..9};
	iconBP := Display.NewPattern(line, 13, 9);
END InitIcon;
Syntax10.Scn.Fnt
	Texts.OpenWriter (w); 
	InitIcon;
	RTDT.debugQ.Add (PCHandler);
	RTDT.debugQ.Add (DataHandler);
	RTDT.startQ.Add (PCOffHandler);
	HandlerElems.ResetHandlers;					(******************  only temporary *******)
	HandlerElems.SetHandler ("PC control", FrameHandle, PrevFrameHandle);
	HandlerElems.SetHandler ("Data control", DataHandle, PrevDataHandle);
	Texts.WriteString (w, "Debugger mah 11.4.95"); Texts.WriteLn (w); Texts.Append (Oberon.Log, w.buf)
Syntax10.Scn.Fnt
	name: ARRAY 32 OF CHAR;
	i, j: INTEGER;
	mod: Modules.Module;
	cmd: Modules.Command;
	s: Texts.Scanner;
	sb, pc: LONGINT;
BEGIN
	IF ~RTDT.Debugging () THEN
		GetArg (s); 
		IF s.class = Texts.Name THEN
			COPY (s.s, name);
			i := 0; j := 0;
			WHILE name[j] # 0X DO 
				IF name[j] = "." THEN i := j END;
				INC(j)
			END;
			IF i > 0 THEN
				name[i] := 0X;	
				mod := Modules.ThisMod (name);
				IF mod # NIL THEN
					INC (i); j := i;
					WHILE name[j] # 0X DO name[j-i] := name[j]; INC (j) END;
					name[j-i] := 0X; cmd := Modules.ThisCommand (mod, name);
					IF cmd # NIL THEN
						SYS.GET (SYS.ADR (cmd), pc);
						SYS.GET (SYS.ADR (cmd)+4, sb);
						lastpos := 0; RTDT.Install; RTDT.Prepare (pc, sb);
						RTDB.StepAll; HALT (RTDT.EnterDebugMode)
					ELSE
						Texts.WriteString (w, "Command not found: "); Texts.WriteString (w, name);
						Texts.WriteLn (w); Texts.Append (Oberon.Log, w.buf)
					END
				ELSE
					Texts.WriteString (w, "Module not found: "); Texts.WriteString (w, name);
					Texts.WriteLn (w); Texts.Append (Oberon.Log, w.buf)
				END
			END
		END
END Start;
Syntax10.Scn.Fnt
BEGIN IF RTDT.Debugging () THEN RTDB.RestoreAll; RTDT.Stop; RTDC.Release END
END Stop;
MODULE Debug; (* Run time debugger: Commands; mah 25.10.94 (
IMPORT	RTDB, RTDT, RTDC, RTDD, Modules, Texts, Oberon, SYS := SYSTEM, Sys, HandlerElems,
			Viewers, MenuViewers, TextFrames, Display, Fonts, FoldElems, System,
CONST
	InfoMenu = "System.Close System.Grow RTD.Data";  	 (* system track *)
	PCElem = POINTER TO PCElemDesc;
	BPElem = POINTER TO BPElemDesc;
	PCElemDesc = RECORD (Texts.ElemDesc)
	BPElemDesc = RECORD (Texts.ElemDesc)
	SetPCMsg = RECORD (Display.FrameMsg)
	UpdateDataMsg = RECORD (Display.FrameMsg) END;
	Text = POINTER TO TextDesc;
	TextDesc = RECORD (Texts.TextDesc)
	w: Texts.Writer;
	iconPC, iconBP: Display.Pattern;	(* x = 0, y = -curfnt.minY, w = 13, h = 9 *)
	lastPos: LONGINT;				(* latest text position of PC *)
	lastBeginPC: LONGINT;			(* start PC of latest procedure on stack *)
	PrevFrameHandle, PrevDataHandle: Display.Handler;
PROCEDURE SkipComment (VAR s: Texts.Scanner);
PROCEDURE Token (VAR s: Texts.Scanner);
PROCEDURE NextToken (t: Texts.Text; VAR pos: LONGINT);
PROCEDURE GetDsr (f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; VAR dsr: INTEGER);
PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);
PROCEDURE PCElemHandle (e: Texts.Elem; VAR msg: Texts.ElemMsg);
PROCEDURE BPElemHandle (e: Texts.Elem; VAR msg: Texts.ElemMsg);
PROCEDURE AllocPCElem (mod: Modules.Module; pc: LONGINT) : PCElem;
PROCEDURE GetArg (VAR s: Texts.Scanner);
PROCEDURE FrameHandle (f: Display.Frame; VAR msg: Display.FrameMsg);
PROCEDURE DataHandle (f: Display.Frame; VAR msg: Display.FrameMsg);
VAR t: Text; mod: Modules.Module; ok: BOOLEAN; p: RTDT.Proc; org: LONGINT;
BEGIN
	WITH f: TextFrames.Frame DO
		WITH msg: UpdateDataMsg DO
			IF f.text IS Text THEN
				t := f.text(Text);
				IF t.regs = NIL THEN 										(* global scope *)
					mod := Modules.ThisMod (t.modName);
					IF mod # NIL THEN
						t.base := mod.SB;
						RTDD.GetScope (w, t, t.syms, t.base, 0)
					ELSE Texts.WriteString (w, "Module not loadable")
					END
				ELSE														(* local scope *)
					p := RTDT.procs;
					WHILE (p # NIL) & (p.regs # t.regs) DO p := p.up END;
					IF p # NIL THEN RTDD.GetLocalScope (w, t, t.syms, t.regs, 0)
					ELSE Texts.WriteString (w, "Old View")
					END
				END;
				org := f.org;
				Texts.Delete (t, 0, t.len);
				Texts.Append (t, w.buf);
				TextFrames.Show (f, org)
			ELSE PrevDataHandle (f, msg) END
		ELSE PrevDataHandle (f, msg) END
END DataHandle;
PROCEDURE PCHandler;
PROCEDURE PCOffHandler;
PROCEDURE NewText (syms: RTDC.Sym; base: LONGINT; regs: Sys.ExceptionInfo; VAR modName: ARRAY OF CHAR) : Text;
PROCEDURE DataHandler;
PROCEDURE StepInto*;
PROCEDURE Step*;
PROCEDURE Return*;
PROCEDURE Run*;
PROCEDURE PostMortem*;
PROCEDURE Close*;
BEGIN
	lastPos := 0; lastBeginPC := 0;
	RTDB.CleanUp;
	RTDT.Stop
END Close;
PROCEDURE Trace*;
VAR s: Texts.Scanner;
BEGIN
	IF RTDT.Debugging () OR RTDT.Launching () THEN Close END;
	GetArg (s); RTDB.AddModules (s);
	RTDT.Install; RTDT.Prepare;
	RTDB.EntryAll
END Trace;
PROCEDURE ShowModules*;
PROCEDURE Stack*;
PROCEDURE Source*;
PROCEDURE Breakpoint*;
PROCEDURE Data*;
PROCEDURE InitIcon;
BEGIN
END Debug.
PROCEDURE Start*;
PROCEDURE Stop*;